home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / graphic / postogrf.zip / SCANPS.PAS < prev    next >
Pascal/Delphi Source File  |  1990-05-24  |  7KB  |  179 lines
  1. { Scanps.pas - include file used in POSTOGRF.
  2.   Scans input file for internal markers indicating label positions, font
  3.   definitions, etc.
  4.  
  5.   9 Jan 89. Minor cleanup.
  6.   1 May 89 Now scans to end to look for %StartLabels, %EndLabels; now can
  7.     pick up labels this way even if they are at the end of the file.
  8. }
  9.  
  10. procedure ScanPSOffsets;
  11. const SetOriginSt = '/setorigin';
  12. type chArray1 = array[1..length(SetOriginSt)] of char;
  13.      chArray1Ptr = ^chArray1;
  14. const SetOriginName: chArray1 =  SetOriginSt;
  15. var  saveHere, marker, nn, limit, dobar: word;
  16.      s: string80;
  17.      done: boolean;
  18.  
  19.      procedure FindPhrase(target:string80; limit: word; var marker:word);
  20.      var saveHere: word;
  21.          s, s1: string80;
  22.      begin
  23.           done := false;
  24.           saveHere := here;
  25.           s1 := target[1];
  26.           repeat
  27.               repeat inc(here) until (JimFile^[here] = s1) or (here > limit);
  28.               if here > limit then begin
  29.                    marker := limit;
  30.                    done := true;
  31.                 end
  32.                 else begin
  33.                    GetAWord(s);
  34.                    if s = target then done := true;
  35.                 end;
  36.           until done;
  37.           if here > limit then marker := limit else begin
  38.              marker := here;
  39.              while jimfile^[marker] in pwhitespace do inc(marker);
  40.            end;
  41.           here := saveHere;
  42.      end; {FindPhrase}
  43.  
  44.      procedure GetOriginFromString;
  45.      var  badOrigin: boolean;
  46.           s1: string;
  47.           n1, n2: byte;
  48.           tx,ty: real;
  49.           err: integer;
  50.      begin
  51.           badorigin := false;
  52.           if pos('translate', SetOriginStr) = 0 then badOrigin := true;
  53.           n1 := 0;
  54.           repeat inc(n1);
  55.            until (SetOriginStr[n1] in numbers) or (n1 > 80);
  56.           if n1 > 80 then badOrigin := true else begin
  57.               n2 := n1;
  58.               repeat inc(n2) until not (SetOriginStr[n2] in numbers);
  59.               val(copy(SetOriginStr,n1, n2 - n1), tx, err);
  60.               if err <> 0 then badOrigin := true else begin
  61.                  repeat inc(n2)
  62.                   until (SetOriginStr[n2] in numbers) or (n2 > 80);
  63.                  if n2 > 80 then badOrigin := true else begin
  64.                     n1 := n2;
  65.                     repeat inc(n1) until not (SetOriginstr[n1] in numbers);
  66.                     val(copy(SetOriginStr, n2, n1-n2), ty, err);
  67.                     if err <> 0 then BadOrigin := true;
  68.                   end;
  69.                end;
  70.            end;
  71.           case badOrigin of
  72.              true : begin
  73.                         Layout.Origin := DefaultLayout.Origin;
  74.                      end;
  75.              false: begin
  76.                         with Layout do begin
  77.                             if (pos('rotate', SetOriginStr) = 0) then
  78.                               Landscape := false
  79.                              else Landscape := true;
  80.                             origin.x := integer(round(1000*tx));
  81.                             origin.y := integer(round(1000*ty));
  82.                             ChangeLayout := false;
  83.                          end;
  84.                      end;
  85.            end; {case badOrigin of ...}
  86.      end; {GetOriginFromString}
  87.  
  88.      procedure GetBoundingBox;
  89.      var BBstr: string;
  90.          badBBox: boolean;
  91.          n1, n2: word;
  92.          x1, x2, y1, y2, err: integer;
  93.      begin
  94.         badBBox := false; n2 := 255;
  95.         FindPhrase('%%BoundingBox:', n2, n1);
  96.         if n1 >= n2 then badBBox := true else begin
  97.             BBstr := '';
  98.             n2 := n1;
  99.             while Jimfile^[n2] <> CR do begin
  100.                BBstr := BBstr + JimFile^[n2];
  101.                inc(n2);
  102.              end;
  103.          end;
  104.         if not badBBox then begin
  105.             n1 := 1; n2 := n1;
  106.             repeat inc(n2) until not (BBstr[n2] in numbers);
  107.             val(copy(BBstr, n1, n2-n1), x1, err);
  108.             if err <> 0 then badBBox := true else begin
  109.                 repeat inc(n2) until BBstr[n2] in numbers ;
  110.                 n1 := n2;
  111.                 repeat inc(n2) until not (BBstr[n2] in numbers);
  112.                 val(copy(BBstr, n1, n2-n1), y1, err);
  113.                 if err <> 0 then badBBox := true else begin
  114.                    repeat inc(n2) until BBstr[n2] in numbers ;
  115.                    n1 := n2;
  116.                    repeat inc(n2) until not (BBstr[n2] in numbers);
  117.                    val(copy(BBstr, n1, n2-n1), x2, err);
  118.                    if err <> 0 then badBBox := true else begin
  119.                       repeat inc(n2) until BBstr[n2] in numbers ;
  120.                       n1 := n2;
  121.                       repeat inc(n2) until not (BBstr[n2] in numbers);
  122.                       val(copy(BBstr, n1, n2-n1), y2, err);
  123.                           if err <> 0 then badBBox := true;
  124.                     end;
  125.                  end;
  126.              end;
  127.          end;
  128.          case badBBox of
  129.             true : begin
  130.                       layout.BoundingBox := defaultLayout.BoundingBox;
  131.                     end;
  132.             false: with Layout.BoundingBox do begin
  133.                       LLx := x1; LLy := y1; URx := x2; URy := y2;
  134.                       w := x2 - x1; h := y2 - y1;
  135.                     end;
  136.           end; {case badBBox of ...}
  137.      end; {GetBoundingBox}
  138.  
  139. begin {ScanPSOffsets}
  140.      saveHere := here;
  141.      here := 1;
  142.      { ------------------ find '/setorigin' ------------------------ }
  143.      SetOriginStr := '';
  144.      repeat inc(here) until (chArray1Ptr(@Jimfile^[here])^ = SetOriginName)
  145.             or (here > count);
  146.      if here > count then SetOrigin := count
  147.         else begin
  148.            marker := here;
  149.            repeat GetAWord(s)
  150.            until (s = 'def') or (here > count);
  151.        if here < count then
  152.            for nn := marker to here do
  153.                SetOriginStr := SetOriginStr + JimFile^[nn];
  154.         end;
  155.      here := 1;
  156.      if SetOriginStr = '' then SetOriginStr := DefaultOriginStr;
  157.      GetOriginFromString;
  158.      GetBoundingBox;
  159.      here := count - 5;
  160.      repeat GetAWordBack(s, here); until s = 'showpage';
  161.      count := here;
  162.      here := 1;
  163.      { ----------------- find other key words ----------------------- }
  164.      FindPhrase('%EndLabels',       count,       EndLabels);
  165.      FindPhrase('%StartLabels',     EndLabels,   StartLabels);
  166.      FindPhrase('%EndGraph',        count,       EndGraph);
  167.      FindPhrase('%StartGraph',      EndGraph,    StartGraph);
  168.      FindPhrase('%%EndProlog',      StartLabels, EndProlog);
  169.      here := endprolog;
  170.      FindPhrase('dobar',            EndLabels,   dobar);
  171.      here := 1;
  172.      FindPhrase('%EndFonts',        EndProlog,   EndFonts);
  173.      FindPhrase('%FontDefinitions', EndFonts,    FontDefinitions);
  174.      here := saveHere;
  175.      if dobar < EndLabels then LConfig.DoBar := true
  176.         else Lconfig.DoBar := false;
  177.      SetCopyBlockDef;
  178. end; {ScanPSOffsets}
  179.